home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_ham < prev    next >
Encoding:
Text File  |  1991-12-30  |  2.9 KB  |  128 lines
  1. \ Demonstrate Custom Screen and  HAM - Hold and Modify
  2. \ This will generate a drawing then pause 4 seconds before
  3. \ drawing another
  4. \
  5. \ Authors:  Phil Burk & Brian Donovan
  6. \ Copyright 1986 Delta Research
  7. \
  8. \ MOD: PLB 8/6/88 Use more normal window so ?CLOSEBOX can be used.
  9.  
  10. include? newwindow.setup ju:amiga_graph
  11. include? ?closebox ju:amiga_events
  12. include? newscreen.setup ju:screen_support
  13. include? HAM ji:graphics/view.j
  14. include? msec ju:msec
  15. include? choose ju:random
  16.  
  17. ANEW TASK-DEMO_HAM
  18. decimal
  19. NewScreen HAMNewScreen
  20. NewWindow HAMNewWindow
  21.  
  22.  
  23. VARIABLE HAMScreen
  24.  
  25. : HAM.OPEN.SCREEN ( -- , screen | NULL)
  26.     gr.init
  27. \ Set to default values.
  28.     HAMNewScreen NewScreen.Setup
  29.     HAMNewWindow NewWindow.Setup
  30. \
  31. \ Modify defaults for this demo.
  32.     HAM HAMNewScreen ..! ns_viewmodes   ( Change to HAM )
  33.     6 HAMNewScreen ..! ns_depth
  34.     190 HAMNewScreen ..! ns_TopEdge  ( Start at bottom and scroll up. )
  35. \
  36. \ Open Screen and store pointer in NewWindow structure.
  37.     HAMNewScreen openscreen() dup HAMScreen !  ( Open screen. )
  38. \
  39. \ Sometimes the Amiga can build a bad COPPER list for screens.
  40. \ This can happen if you have Emacs up in INTERLACE mode and open a
  41. \ NON-INTERLACE screen.
  42. \ The following call will correct this problem (hopefully).
  43.     RemakeDisplay()
  44. ;
  45.  
  46. : HAM.OPEN.WINDOW ( screen -- , window | NULL )
  47.     >abs HAMNewWindow ..! nw_screen   ( Modify window for this screen. )
  48. \
  49. \ Set up window.
  50.     CUSTOMSCREEN   HAMNewWindow ..! nw_type
  51.     0" HAM - JForth - Delta Research" >abs
  52.         HAMNewWindow ..! nw_Title
  53.     0    HAMNewWindow ..! nw_TopEdge
  54.     320  HAMNewWindow ..! nw_Width
  55.     200  HAMNewWindow ..! nw_Height
  56. \ Turn off window depth, set ACTIVATE, keep other defaults.
  57.     HAMNewWindow ..@ nw_flags
  58.         WINDOWDEPTH -1 xor AND
  59.         ACTIVATE |   HAMNewWindow ..! nw_flags
  60.     HAMNewWindow gr.opencurw
  61. ;
  62.  
  63. : HAM.CLOSE ( -- , Close screen and window.)
  64.     HAMScreen @ closescreen()
  65. ;
  66.  
  67. : SCREEN.RISEUP ( rel_screen -- , Scroll screen up display. )
  68.     190 0
  69.     DO  dup 0 -1 MoveScreen()
  70.         call graphics_lib WaitTOF drop
  71.     LOOP
  72.     drop
  73. ;
  74.  
  75. \ HAM Drawing routines.
  76. \ Constants for building colors.
  77. $ 10 constant HAM_CHANGE_BLUE
  78. $ 20 constant HAM_CHANGE_RED
  79. $ 30 constant HAM_CHANGE_GREEN
  80.  
  81. : HAM.COLOR!  ( RGB new_value -- , Change colors)
  82.     OR gr.color!
  83. ;
  84.  
  85. : HAM.RANDOM.LINES ( N -- )
  86.     0 DO
  87.         64 choose gr.color!
  88.         320 choose 200 choose gr.draw
  89.     LOOP
  90. ;
  91.  
  92. : HAM.RANDOM.BOXES ( N -- )
  93.     0 DO
  94.         64 choose gr.color!
  95.         320 choose 320 choose 2sort
  96.         200 choose 200 choose 2sort
  97.         >r swap r> gr.rect
  98.     LOOP
  99. ;
  100.  
  101.  
  102. : HAM.POP.ART ( -- , Create drawings until key hit. )
  103.     BEGIN
  104.         100 choose ham.random.boxes
  105.             50 choose ham.random.lines
  106.         4000 msec
  107.         ?closebox
  108.     UNTIL
  109. ;
  110.  
  111. : HAM-ART  ( -- Run HAM demo. )
  112.     ." HAM - JForth - Delta Research" cr
  113.     ham.open.screen ?dup
  114.     IF  ham.open.window
  115.         IF  100 choose ham.random.boxes
  116.             50 choose ham.random.lines
  117.             HAMScreen @ screen.riseup
  118.             ham.pop.art
  119.             gr.closecurw
  120.         THEN
  121.         ham.close
  122.     ELSE ." Could not open screen!" cr
  123.     THEN
  124.     gr.term
  125. ;
  126.  
  127. ." Enter:    HAM-ART   for demo." cr
  128.